home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.07 Jul 88 / Forth Source / Priority task scheduling / Scheduler1.1
Encoding:
Text File  |  1988-04-06  |  7.5 KB  |  226 lines  |  [TEXT/MACH]
  1. .( Priority based multitasking on the Macintosh ) cr
  2. ( Original concept: D.Bryant, G.Caunt, G.Else 1987 )
  3. ( Modifications and Generalisation C.A.Maynard 1988 Wave=onic Associates)
  4. ( Version 1.1 060488 )
  5. Decimal
  6. ( -------------------------------------------------------------------------- )
  7. ( Task and window configurations for the necessary tasks )
  8. ( -------------------------------------------------------------------------- )
  9. 400 1000 background schedulertask
  10. 400 1000 terminal prioritytask
  11.  
  12. new.window PriorityWindow
  13. " PRIORITIES" PriorityWindow Title ( create the priority window )
  14. 40 250 110 500 PriorityWindow Bounds
  15. Document Visible NoCloseBox GrowBox PriorityWindow Items
  16. PriorityWindow Add
  17. ( -------------------------------------------------------------------------- )
  18. ( DEMO Tasks and windows )
  19. ( -------------------------------------------------------------------------- )
  20. 400 1000 terminal task1
  21. 400 1000 terminal task2
  22. 400 1000 terminal task3
  23.  
  24. new.window Task1Window
  25. " TASK 1" Task1Window Title ( create the TASK 1 window )
  26. 140 20 310 180 Task1Window Bounds
  27. Document Visible NoCloseBox NoGrowBox Task1Window Items
  28. Task1Window Add
  29.  
  30. new.window Task2Window
  31. " TASK 2" Task2Window Title ( create the TASK 2 window )
  32. 140 180 310 340 Task2Window Bounds
  33. Document Visible NoCloseBox NoGrowBox Task2Window Items
  34. Task2Window Add
  35.  
  36. new.window Task3Window
  37. " TASK 3" Task3Window Title ( create the TASK 3 window )
  38. 140 340 310 500 Task3Window Bounds
  39. Document Visible NoCloseBox NoGrowBox Task3Window Items
  40. Task3Window Add
  41. ( -------------------------------------------------------------------------- )
  42. ( USER Variable definitions )
  43. ( -------------------------------------------------------------------------- )
  44. 72 user TaskWindow
  45. 220 user rleft
  46. 224 user rright
  47. 228 user rtop
  48. 232 user rbot
  49. 236 user diff             ( create rectangle coords as user variables for each task )
  50. 240 user angle
  51. 244 user rectangle     ( space for 8 bytes needed. Next slot 252)
  52. ( -------------------------------------------------------------------------- )
  53. ( Scheduling Task Definitions )
  54. ( -------------------------------------------------------------------------- )
  55. VARIABLE LevelAddr     ( Global temporary storage for the scheduler )
  56. VARIABLE NTASKS         ( Number of runnable tasks  MAX 10)
  57. 0 NTASKS !                     ( Initialise to zero )
  58. VARIABLE PTASKS 120 VALLOT 
  59.                                         ( Storage for Level, Priority and Task Address )
  60. : Wakeup ( a1 - )
  61. ( Wakeup gets the next task running given the status address )
  62. sleep status W!
  63. wake swap W! pause ;
  64.  
  65. : SwitchTask 
  66. ( Call the scheduler to see who's next )
  67. sleep status W!
  68. wake status task-> schedulertask W!
  69. pause ;
  70.  
  71. : SCHED 
  72. ( Define a general task scheduling process )
  73. activate
  74. begin 
  75. NTasks @ dup 0> if                                     ( only execute defined tasks )
  76. 0 DO
  77.     I 12 * PTasks + dup LevelAddr ! @ ( Get the address and current level )
  78.     LevelAddr @ 4 + @                                 ( Get priority setting )
  79.     + dup LevelAddr @ !                             ( Save new level )
  80.     100 - dup 0> if                                        ( Modify level if necessary )
  81.         LevelAddr @ !
  82.         LevelAddr @ 8 + @ Wakeup
  83.     else
  84.         drop
  85.     then
  86. LOOP
  87. else drop then pause
  88. again ;
  89. ( -------------------------------------------------------------------------- )
  90. cr
  91. .( Clive Maynard's Forth Environment extract ) cr
  92. .( C.A.Maynard 020488 ) cr
  93.  
  94. also assembler
  95.  
  96. code LVALLOT ( n - addr )
  97. ( Set up a local buffer. Only callable from a word with local variables )
  98. ( UNLK will clean up the stack. USER beware of buffer overflow!!! )
  99.     MOVE.L     (A6)+,D0    ( GET SIZE IN BYTES )
  100.     MOVEA.L    (A7)+,A0    ( GET RETURN INFO )
  101.     SUBA.L     D0,A7        ( NEW SP )
  102.     MOVE.L    A7,-(A6)    ( COPY ADDRESS TO PARAMETER STACK )
  103.     JMP    (A0)
  104. end-code
  105.  
  106. -1 CONSTANT TRUE
  107. 0 CONSTANT FALSE
  108.  
  109. : #terminator? ( char - f ) 
  110. ( check for the terminator of a number: space or CR )
  111. case
  112. 13 of true swap endof
  113. 32 of true swap endof
  114. false swap
  115. endcase ;
  116.  
  117. : PTexpect { buffad nchars | buffadd countup - }
  118. ( Fills a buffer but includes Priority Task switching )
  119. buffad 1 + -> buffadd 0 -> countup
  120. nchars 0 do
  121.     begin 
  122.     SwitchTask         
  123.     ?terminal until 
  124.     key dup emit dup buffadd C! 1 +> buffadd 1 +> countup
  125.     #terminator? if leave then 
  126. loop 
  127. countup buffad c! ;
  128.  
  129. : #IN { | buffaddr - number }
  130. ( PC/FORTH intrinsic function!! )
  131. ( Collect into a 10 byte buffer and return a number input )
  132. 10 lvallot ( set up a local buffer very carefully )
  133.  -> buffaddr
  134. buffaddr 10 PTexpect
  135. buffaddr number? drop ;
  136. ( -------------------------------------------------------------------------- )
  137. ( A new task building word for Priority Tasks )
  138. ( -------------------------------------------------------------------------- )
  139. : PBUILD { TaskAddr | LevelAdr - }
  140. ( Initialise conditions for new tasks )
  141. NTasks 10 = abort" Task Priority Table Full. New entry denied"
  142. NTasks @ 12 * PTasks +                     ( Get offset into table )
  143. dup -> LevelAdr 0 swap !                 ( Set Level to zero )
  144. 10 LevelAdr 4 + !                             ( Set Priority to default of 10 )
  145. TaskAddr BUILD                                     ( Now do an ordinary task build )
  146. TaskAddr @ LevelAdr 8 + !             ( Save Status address )
  147. NTasks @ 1+ NTasks !                         ( Increase task count )
  148. ;
  149. ( -------------------------------------------------------------------------- )
  150. ( The Priority Task Definition )
  151. ( -------------------------------------------------------------------------- )
  152. : getbuff { | taskno priority - }
  153. ( priority reallocation routine)
  154. #in dup ." Task " . -> taskno cr
  155. taskno NTasks @ < taskno 0> and if 
  156. #in dup 0< if drop 0 then dup ." Priority " . -> priority                                                             ( New priority determined )
  157.     priority 101 < IF
  158.         priority dup 0= if cr ." Zero or negative priority halts the task" cr then 
  159.     taskno 12 * 4 + PTasks + !     ( Get to priority storage location )
  160.         ELSE cr ." Priority out of range. No change" cr THEN
  161. else cr ." Task number out of range. No change" cr then ;
  162.  
  163. : setpriority ( priority allocation task)
  164. activate
  165. begin
  166. taskwindow @ call SetPort
  167. ." Enter the task number followed by" cr ." its desired priority" cr
  168. ." Priorities can be from 0 to 100" cr
  169.     ?terminal if
  170.     getbuff cr then
  171.     SwitchTask 
  172. again ;
  173. ( -------------------------------------------------------------------------- )
  174. ( The other tasks )
  175. ( -------------------------------------------------------------------------- )
  176. : DISKS 
  177. activate
  178.                                                 ( Initialise variables )
  179. -7 diff ! 0 angle !
  180. 10 rleft W! 20 rtop W!
  181. 150 rright W! 160 rbot W!
  182.                                                 ( Loop through graphic changes in superb animation )
  183. begin
  184.     rectangle rleft W@ rtop W@ rright W@ rbot W@ call SetRect
  185.     begin
  186.         359 angle @ - 0>
  187.     while
  188.         taskwindow @ call SetPort
  189.         angle @ 10 + angle !
  190.         rectangle angle @ 10 call InvertArc
  191.         SwitchTask
  192.     repeat
  193.     taskwindow @ call SetPort
  194.     rright W@ diff @ + rright W!
  195.     rbot W@ diff @ + rbot W!
  196.     rright W@ rleft W@ - 5 < if
  197.         7 diff ! then
  198.     rright W@ rleft W@ - 140 > if
  199.         rectangle 0 360 call EraseRect -7 diff ! then
  200.     0 angle !
  201.     SwitchTask                        ( Get back to the scheduler )
  202. again ;
  203. ( -------------------------------------------------------------------------- )
  204. ( Initiate the necessary tasking operations )
  205. ( -------------------------------------------------------------------------- )
  206. schedulertask build ( slot the scheduler into the round robin loop )
  207. schedulertask sched
  208.  
  209. prioritywindow prioritytask Pbuild
  210. prioritytask setpriority
  211. ( -------------------------------------------------------------------------- )
  212. .( Define task insertion words to show adding tasks to priority system ) cr
  213. .( Shrink Mach 2 window to top left corner ) cr
  214. .( Execute  task words: atask, btask and ctask after loading the file ) cr
  215. .( Change priority through the priority task window ) cr
  216. ( -------------------------------------------------------------------------- )
  217. : Atask task1window task1 Pbuild
  218. task1 disks ;
  219.  
  220. : Btask task2window task2 Pbuild
  221. task2 disks ;
  222.  
  223. : Ctask task3window task3 Pbuild
  224. task3 disks ;
  225.  
  226.